home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / marks.tcl < prev    next >
Encoding:
Text File  |  1998-11-21  |  5.7 KB  |  254 lines  |  [TEXT/ALFA]
  1.  
  2. # ================================================================================
  3. # Marks for front window.
  4. #================================================================================
  5.  
  6. proc namedMarkProc {menu item} {
  7.     switch -- $item {
  8.     "markFile"            {markFile; message "File marked."}
  9.     "set"                 {setNamedMark}
  10.     "goto"                {gotoFileMark}
  11.     "remove"            {removeNamedMark}
  12.     "sort"                {sortMarksFile}
  13.     "sortByPosition"    {orderMarks}
  14.     }
  15. }
  16.  
  17. proc unnamedMarkproc {menu item} {
  18.     switch -- $item {
  19.     "set"                     {setMark}
  20.     "exchangePointAndMark"    {exchangePointAndMark}
  21.     "hilite"                {markHilite}
  22.     }
  23. }
  24.     
  25.  
  26.  
  27. proc gotoFileMark {} {
  28.     set text [getSelect]
  29.     if {[string length $text] && ([string length $text] < 20)} {
  30.     gotoMark [listpick -p "Mark?" -L [list $text] [getNamedMarks -n]]
  31.     } else {
  32.     gotoMark [listpick -p "Mark?" [getNamedMarks -n]]
  33.     }
  34. }
  35.  
  36. proc markFile {} {
  37.     if {[llength [getNamedMarks -n]]} {
  38.     global quietlyClearMarks
  39.     if {$quietlyClearMarks || [dialog::yesno -c "Clear old marks?"]} {
  40.         clearFileMarks
  41.     }
  42.     }
  43.     global mode
  44.     mode::proc MarkFile
  45. }
  46.  
  47. proc removeAllMarks {{pat *}} {
  48.     set win [win::Current]
  49.     if {![catch {
  50.     foreach mk [getNamedMarks -n] {
  51.         if {[string match $pat $mk]} {
  52.         removeNamedMark -n $mk -w $win
  53.         }
  54.     } } ] } { 
  55.     return 
  56.     }
  57.     # some marks contain curly braces!
  58.     foreach mk [quote::Regfind [getNamedMarks -n]] {
  59.     if {[string match $pat $mk]} {
  60.         removeNamedMark -n $mk -w $win
  61.     }
  62.     if {[string index $mk 0] == "\{"} {
  63.         set mk [string range $mk 1 [expr {[string length $mk] -1}]]
  64.     }
  65.     if {[string match $pat $mk]} {
  66.         removeNamedMark -n $mk -w $win
  67.     }
  68.     }
  69. }
  70.  
  71. proc clearFileMarks {} {removeAllMarks}
  72.  
  73. proc sortMarksFile {} {
  74.     if {![dialog::yesno "Really sort all marks?"]} {return}
  75.     
  76.     set nm [win::Current]
  77.     
  78.     set mks {}
  79.     foreach mk [getNamedMarks] {
  80.     removeNamedMark -n [lindex $mk 0] -w [lindex $mk 1]
  81.     lappend mks $mk
  82.     }
  83.     
  84.     foreach mk [lsort $mks] {
  85.     set name [lindex $mk 0]
  86.     set disp [lindex $mk 2]
  87.     set pos [lindex $mk 3]
  88.     set end [lindex $mk 4]
  89.     
  90.     setNamedMark $name $disp $pos $end
  91.     }
  92. }
  93.  
  94. # From Mark Nagata
  95. proc zeroadd {num} {
  96.     set mx [maxPos]
  97.     set len [string length $mx]
  98.     set num [format "%0${len}d" $num]
  99.     return $num
  100. }
  101.  
  102. proc orderMarks {} {
  103.     if {![dialog::yesno "Really reorder all marks?"]} {return}
  104.     
  105.     set nm [win::Current]
  106.     
  107.     set wks {}
  108.     foreach mk [getNamedMarks] {
  109.     removeNamedMark -n [lindex $mk 0] -w $nm
  110.     set name [lindex $mk 0]
  111.     set disp [lindex $mk 2]
  112.     set pos [lindex $mk 3]
  113.     set end [lindex $mk 4]
  114.     set pos [zeroadd $pos]
  115.     set wk [list $pos $disp $name $end]
  116.     lappend wks $wk
  117.     }
  118.     
  119.     foreach wk [lsort $wks] {
  120.     set name [lindex $wk 2]
  121.     set disp [lindex $wk 1]
  122.     set pos [lindex $wk 0]
  123.     set end [lindex $wk 3]
  124.     
  125.     setNamedMark $name $disp $pos $end
  126.     }
  127. }
  128.  
  129.  
  130. # ================================================================================
  131. # Simple mark stack implementation
  132. # ================================================================================
  133.  
  134. proc placeBookmark {{msg 1}} {
  135.     global markStack
  136.     global markName
  137.     
  138.     set name mark$markName
  139.     incr markName
  140.     createTMark $name [getPos]
  141.     set fileName [win::Current]
  142.     set markStack [linsert $markStack 0 [list $fileName $name]]
  143.     if {$msg} {
  144.     message "Placed bookmark \#[llength $markStack]"
  145.     }
  146. }
  147.  
  148. proc returnToBookmark {{msg 1}} {
  149.     global markStack
  150.     if {[llength $markStack] == "0"} {
  151.     message "No bookmarks have been placed!"
  152.     return
  153.     }
  154.     set mark [lindex [lindex $markStack 0] 1]
  155.     set markStack [lreplace $markStack 0 0]
  156.     if {[catch {gotoTMark $mark}]} {
  157.     returnToBookmark
  158.     return
  159.     }
  160.     if {$msg} {
  161.     message "Returned to bookmark \#[expr {[llength $markStack] + 1}]"
  162.     }
  163. }
  164.  
  165. # Used to create a popup of all funcs in window. Routine 
  166. # should return list containing, consecutively, proc name and
  167. # start of definition. 
  168. proc parseFuncsAlpha {} {
  169.     mode::proc parseFuncs
  170. }
  171.  
  172. proc ::parseFuncs {} {
  173.     global sortFuncsMenu funcExpr parseExpr
  174.     
  175.     set pos [minPos]
  176.     set m {}
  177.     if {$sortFuncsMenu} {
  178.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  179.         if {[regexp $parseExpr [eval getText $res] dummy word]} {
  180.         lappend m [list $word [lindex $res 0]]
  181.         }
  182.         set pos [lindex $res 1]
  183.     }
  184.     regsub -all "\[\{\}\]" [lsort -ignore $m] "" m
  185.     } else {
  186.     while {[set res [search -s -f 1 -r 1 -i 0 -n $funcExpr $pos]] != ""} {
  187.         if {[regexp $parseExpr [eval getText $res] dummy word]} {
  188.         lappend m $word [lindex $res 0]
  189.         }
  190.         set pos [lindex $res 1]
  191.     }
  192.     }
  193.     return $m
  194. }
  195.  
  196. proc gotoFunc {} {
  197.     set l [parseFuncsAlpha]
  198.     if {[set ind [lsearch $l {(-}]] >= 0} {
  199.     set l [lrange $l [expr {$ind + 2}] end]
  200.     }
  201.     
  202.     while {[llength $l] > 1} {
  203.     lappend names [lindex $l 0]
  204.     lappend positions [lindex $l 1]
  205.     set l [lrange $l 2 end]
  206.     }
  207.     
  208.     set res [listpick -p "Func:" $names]
  209.     if {[set ind [lsearch $names $res]] >= 0} {
  210.     goto [lindex $positions $ind]
  211.     }
  212. }
  213.  
  214.  
  215. proc editMark {fname mname args} {
  216.     if {[set pos [lsearch [winNames -f] "*$fname*"]] >= 0}  {
  217.         bringToFront [lindex [winNames -f] $pos]
  218.     if {[icon -q]} {
  219.         icon -o
  220.     } 
  221.     } else {
  222.         if {[lsearch $args {-r}] >= 0} {
  223.         edit -r "$fname"
  224.         } else {
  225.         edit "$fname"
  226.     }
  227.     }
  228.     set mNames [getNamedMarks -n]
  229.     if {[set closestFound [lsearch -glob $mNames "*${mname}*"]] < 0} {
  230.     catch {mode::proc MarkFile}
  231.     set mNames [getNamedMarks -n]
  232.     } 
  233.     if {[lsearch $mNames "${mname}"] >= 0} {
  234.         gotoMark $mname
  235.     } elseif {[lsearch $mNames " ${mname}"] >= 0} {
  236.     #this gets used when procName is indented in pop-up -tr
  237.         gotoMark " $mname"
  238.     } else {
  239.     if {$closestFound == -1} {
  240.         return 1
  241.     } else {
  242.         gotoMark [lindex $mNames $closestFound]
  243.     }
  244.     
  245.     }
  246.     return 0
  247. }
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.